home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Add-Ons / BBEdit / MacBob 1.0ß2 / Source / Bob / Functions.cp < prev    next >
Encoding:
Text File  |  1995-12-12  |  5.8 KB  |  327 lines  |  [TEXT/KAHL]
  1. /***
  2.   *
  3.   *    Functions.cp - built-in classes and functions
  4.   *
  5.   *    Original code: Copyright (c) 1991, by David Michael Betz.  All rights reserved
  6.   *    Modifications and additions: Copyright © by Christopher E. Hyde, 1995
  7.   *
  8.   ***/
  9.  
  10. #include "Bob.h"
  11.  
  12. // argument check macros
  13. #define    ArgCount(cnt)        { if (argc != cnt) WrongCount(argc, cnt); }
  14. #define    CheckType(o,t)        { if IsNotType(o, t) BadType(o,t); }
  15. #define    Check0(t)            { if IsNotType(0, t) Arg0Not(t); }
  16. #define    CheckInt0()        { if IsNotType(0, tInteger) Arg0NotInt(); }
  17. #define    CheckInt1()        { if IsNotType(1, tInteger) Arg1NotInt(); }
  18.  
  19. #define    DefOpFn(n)        static _DefOpFn(x##n)
  20. #define    AddOpFn(n)        DefOpFn(n); AddFunction(#n, x##n)
  21.  
  22. // external variables
  23. extern TValue symbols;
  24.  
  25. // forward declarations
  26. static void    AddFunction        (KStr name, OpFn fcn);
  27. static void    WrongCount        (int n, int cnt);
  28. #pragma noreturn(WrongCount)
  29.  
  30.  
  31. // Initialize the internal functions
  32. void
  33. InitFunctions (void)
  34. {
  35.     AddOpFn(typeof);
  36.     AddOpFn(gc);
  37.     AddOpFn(newvector);
  38.     AddOpFn(newstring);
  39.     AddOpFn(sizeof);
  40.     AddOpFn(fopen);
  41.     AddOpFn(fclose);
  42.     AddOpFn(getc);
  43.     AddOpFn(putc);
  44.     AddOpFn(print);
  45.     AddOpFn(getarg);
  46.     AddOpFn(system);
  47.  
  48.     AddOpFn(getfile);
  49. //    AddOpFn(putfile);
  50.     AddOpFn(trace);
  51. }
  52.  
  53.  
  54. // Add a built-in function
  55. void
  56. AddFunction (KStr name, OpFn fcn)
  57. {
  58.     Entry sym = AddEntry(&symbols, name, stSFunction);
  59.  
  60.     set_code(&sym->fValue, fcn);
  61. }
  62.  
  63.  
  64. // Set program tracing on/off
  65. DefOpFn(trace)
  66. {
  67.     ArgCount(1);
  68.     CheckInt0();
  69.     Opt(TraceExec) = (sp->fInt != 0);
  70.     ++sp;
  71.     set_nil(sp);
  72. }
  73.  
  74.  
  75. #include <StandardFile.h>    
  76.  
  77.  
  78. // Get an input file stream from the user
  79. DefOpFn(getfile)
  80. {
  81.     SFTypeList typeList;
  82.     StandardFileReply reply;
  83.     short numTypes = -1;
  84.  
  85.     if (argc == 1) {    // Optional argument is file type
  86.         Check0(tString);
  87.         if (SLen(sp) >= sizeof(OSType)) {
  88.             typeList[0] = *(OSType*) SData(sp);
  89.             numTypes = 1;
  90.         }
  91.         ++sp;
  92.     } else
  93.         ArgCount(0);
  94.  
  95.     StandardGetFile(nil, numTypes, typeList, &reply);
  96.     if (reply.sfGood) {
  97.         bool canDispose;
  98.         Handle h = BBEdit->GetFileText(reply.sfFile.vRefNum,
  99.                             reply.sfFile.parID, reply.sfFile.name, &canDispose);
  100.         FailNil(h);
  101.         gInput.Close();
  102.         gInput.Open(h, canDispose);
  103. //        set_iostream(sp, newiostream(&fileio, fp));
  104.     }
  105.     set_integer(sp, reply.sfGood);
  106. }
  107.  
  108.  
  109. // Get the data type of a value
  110. DefOpFn(typeof)
  111. {
  112.     ArgCount(1);
  113.     set_integer(&sp[1], sp->fType);
  114.     ++sp;
  115. }
  116.  
  117.  
  118. // Invoke the garbage collector
  119. DefOpFn(gc)
  120. {
  121.     ArgCount(0);
  122.     GC();
  123.     set_nil(sp);
  124. }
  125.  
  126.  
  127. // Allocate a new vector
  128. DefOpFn(newvector)
  129. {
  130.     ArgCount(1);
  131.     CheckInt0();
  132.     int size = sp->fInt;
  133.     set_vector(&sp[1], NewVector(size));
  134.     ++sp;
  135. }
  136.  
  137.  
  138. // Allocate a new string
  139. DefOpFn(newstring)
  140. {
  141.     ArgCount(1);
  142.     CheckInt0();
  143.     int size = sp->fInt;
  144.     set_string(&sp[1], NewString(size));
  145.     ++sp;
  146. }
  147.  
  148.  
  149. // Get the size of a vector or string
  150. DefOpFn(sizeof)
  151. {
  152.     ArgCount(1);
  153.     if (sp->fType == tVector || sp->fType == tString)
  154.         set_integer(&sp[1], VLen(sp));
  155.     ++sp;
  156. }
  157.  
  158.  
  159. // Open a file
  160. DefOpFn(fopen)
  161. {
  162.     char    name[50], mode[10];
  163.     FILE*    fp;
  164.  
  165.     ArgCount(2);
  166.     Check0(tString);
  167.     CheckType(1, tString);
  168.     GetCString(name, sizeof(name), &sp[1]);
  169.     GetCString(mode, sizeof(mode), &sp[0]);
  170. #if 0
  171.     if ((fp = fopen(name, mode)) == nil)
  172.         set_nil(&sp[2]);
  173.     else
  174.         set_iostream(&sp[2], newiostream(&fileio, fp));
  175. #else
  176.     set_nil(&sp[2]);
  177. #endif
  178.     sp += 2;
  179. }
  180.  
  181.  
  182. // Close a file
  183. DefOpFn(fclose)
  184. {
  185.     ArgCount(1);
  186.     Check0(tStream);
  187. //    set_integer(&sp[1], iosclose(&sp[0]));
  188.     iosclose(&sp[0]);
  189.     set_integer(&sp[1], 0);
  190.     ++sp;
  191. }
  192.  
  193.  
  194. // Get a character from a file
  195. DefOpFn(getc)
  196. {
  197.     ArgCount(1);
  198.     Check0(tStream);
  199.     set_integer(&sp[1], iosgetc(&sp[0]));
  200.     ++sp;
  201. }
  202.  
  203.  
  204. // Output a character to a file
  205. DefOpFn(putc)
  206. {
  207.     ArgCount(2);
  208.     Check0(tStream);
  209.     CheckInt1();
  210. //    set_integer(&sp[2], iosputc((int)sp[1].fInt, &sp[0]));
  211.     iosputc(char(sp[1].fInt), &sp[0]);
  212.     set_integer(&sp[2], 0);
  213.     sp += 2;
  214. }
  215.  
  216.  
  217. // Generic print function
  218. DefOpFn(print)
  219. {
  220.     extern TValue stdout_iostream;
  221.  
  222.     for (int n = argc; --n >= 0; )
  223.         Print(&stdout_iostream, false, &sp[n]);
  224.     sp += argc;
  225.     set_nil(sp);
  226. }
  227.  
  228.  
  229. // Print one value
  230. void
  231. Print (Value ios, bool quoteIt, ConstValue val)
  232. {
  233.     char    buf[200];
  234.     TId        name;
  235.  
  236.     switch (val->fType) {
  237.     case tNil:
  238.         iosputs("nil", ios);
  239.         break;
  240.     case tClass:
  241.         GetCString(name, sizeof(name), clgetname(val));
  242.         sprintf(buf, "#<Class-%s>", name);
  243.         iosputs(buf, ios);
  244.         break;
  245.     case tObject:
  246.         sprintf(buf, "#<Object-%lX>", objaddr(val));
  247.         iosputs(buf, ios);
  248.         break;
  249.     case tVector:
  250.         sprintf(buf, "#<Vector-%lX>", vecaddr(val));
  251.         iosputs(buf, ios);
  252.         break;
  253.     case tInteger:
  254.         sprintf(buf, "%ld", val->fInt);
  255.         iosputs(buf, ios);
  256.         break;
  257.     case tString:
  258.         if (quoteIt) iosputc('"', ios);
  259.         ((COStream*) ios_t(ios))->Put(SData(val), SLen(val));
  260.         if (quoteIt) iosputc('"', ios);
  261.         break;
  262.     case tByteCode:
  263.         sprintf(buf, "#<Bytecode-%lX>", vecaddr(val));
  264.         iosputs(buf, ios);
  265.         break;
  266.     case tCode:
  267.         sprintf(buf, "#<Code-%lX>", val->fCode);
  268.         iosputs(buf, ios);
  269.         break;
  270.     case tVar:
  271.         Value aClass = digetclass(degetdictionary(val));
  272.         if (!isnil(aClass)) {
  273.             GetCString(name, sizeof(name), clgetname(aClass));
  274.             sprintf(buf, "%s::", name);
  275.             iosputs(buf, ios);
  276.         }
  277.         GetCString(name, sizeof(name), degetkey(val));
  278.         iosputs(name, ios);
  279.         break;
  280.     case tStream:
  281.         sprintf(buf, "#<Stream-%lX>", val->fStream);
  282.         iosputs(buf, ios);
  283.         break;
  284.     default:
  285.         Error("Undefined type: %d", valtype(val));
  286.     }
  287. }
  288.  
  289.  
  290. // Get an argument from the argument list
  291. DefOpFn(getarg)
  292. {
  293.     extern char**    bobargv;
  294.     extern int        bobargc;
  295.  
  296.     ArgCount(1);
  297.     CheckInt0();
  298.     int i = sp[0].fInt;
  299.     if (i >= 0 && i < bobargc)
  300.         set_string(&sp[1], MakeString(bobargv[i]));
  301.     else
  302.         set_nil(&sp[1]);
  303.     ++sp;
  304. }
  305.  
  306.  
  307. // xsystem - execute a system command
  308. DefOpFn(system)
  309. {
  310.     char cmd[133];
  311.  
  312.     ArgCount(1);
  313.     Check0(tString);
  314.     GetCString(cmd, sizeof(cmd), &sp[0]);
  315. //    set_integer(&sp[1], system(cmd));
  316.     set_integer(&sp[1], -1);
  317.     ++sp;
  318. }
  319.  
  320.  
  321. // Report wrong number of arguments
  322. void
  323. WrongCount (int n, int cnt)
  324. {
  325.     Error((n < cnt) ? "Too many arguments" : "Too few arguments");
  326. }
  327.